perm filename CB.OLD[MSS,LCS] blob
sn#107248 filedate 1974-06-15 generic text, type T, neo UTF8
SUBROUTINE CMBN
COMMON /RC/MCLEF(400),IST(4000)
COMMON /FL/NX,N,L,M,NM,J,NT
DIMENSION IP(10),NMS(10),NF(2500)
EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
C ***** ****** **** ****** ↑ 20 FOR OVERRUN IN IP(11) AT 119
C USE FILE NAMES CLFX, DRAW1 AND DRAW2. 400 WD LIMIT PER FILE.
IF(N.EQ.'S')GO TO 103
102 TYPE 1
1 FORMAT(' TYPE OUTPUT FILE NAME ',$)
10 FORMAT(A5)
DO 122 K=1,10
122 NMS(K)=' '
ACCEPT 10,NM
IF(NM.NE.' ')GO TO 40
NM=LASTNM
TYPE 107,J,LASTNM
40 LASTNM=NM
IF(LOOKD(NM).EQ.0)GO TO 100
IF(N.NE.'C')GO TO 103
C FOR ADDING TO COMBINED FILE.
TYPE 101,NM
ACCEPT 10,NX
IF(NX.EQ.'N')GO TO 102
100 IF(N.EQ.'C')GO TO 104
TYPE 52
GO TO 102
104 NX=0
IP(1)=1
L=1
J=1
I=0
30 TYPE 41
41 FORMAT(' TYPE FILE NAME ',$)
ACCEPT 10,NW
IF(NW.EQ.' ')GO TO 8
IF(LOOKD(NW))GO TO 51
TYPE 52
GO TO 30
52 FORMAT(' FILE NOT FOUND'/)
51 I=I+1
NMS(I)=NW
CALL IFILE(20,NW)
IP(L)=J
READ(20,5)M,M,M,M
50 READ(20,5)M,M,(MCLEF(K),K=J,J+M-1)
NX=NX+MCLEF(J)
IF(NX.LT.M)M=NX
7 J=J+M
READ(20,5,END=62)M,M,(MCLEF(K),K=J,J+M-1)
IF(M)GO TO 62
GO TO 7
62 J=NX+1
L=L+1
IF(L.LT.11)GO TO 30
CC GO TO 80
101 FORMAT(' WRITE OVER ',A5,'.DAT? Y OR N? ',$)
8 CALL OFILE(1,NM)
IP(L)=NX+1
NX=NX-1
IF(L.EQ.10)GO TO 80
DO 81 K=L+1,10
81 IP(K)=0
80 WRITE(1,9)IP
J=1
NT=0
14 CALL SAVE(MCLEF(J))
NT=NT+MCLEF(J)+1
11 IF(NT.GT.NX)GO TO 4
J=NT
NT=NT-1
GO TO 14
6 FORMAT(' 9999 ',10A5)
4 WRITE (1,6),NMS
RETURN
9 FORMAT(' 9999 ',10I6)
5 FORMAT(12I)
1103 TYPE 1104,ID
1104 FORMAT(' FILE FULL -- SAVED AS ',A5)
L=1
NM=ID
NX=MCLEF(1)
GO TO 8
103 CALL IFILE(20,NM)
READ(20,5)K,IP
NX=1
105 READ(20,5,END=106)K,K,(NF(L),L=NX,NX+K-1)
REREAD 107,L,NMS
IF(NMS(1))GO TO 106
NX=NX+K
GO TO 105
107 FORMAT(I,10A5)
106 TYPE 108,NMS
108 FORMAT(' IDENT. NAMES:'/,10(2XA5))
IF(N.EQ.'S')RETURN
C JUST PRINTS OUT NAMES
TYPE 109
109 FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
ACCEPT 209,ID
IF(ID.EQ.' ')GO TO 102
209 FORMAT(A5)
JD=0
L=0
NX=NX-1
DO 110 K=1,10
IF(NMS(K).EQ.ID)JD=K
IF(NMS(K).EQ.' ')GO TO 112
L=K
110 IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
112 IF(N.EQ.'Z')GO TO 127
C FOR DELETIONS
L=L+1
IF(JD.NE.0)GO TO 111
C ADDS ON TO END
N=0
DO 113 K=NX+1,MCLEF(1)+NX
N=N+1
113 NF(K)=MCLEF(N)
NX=NX+N
NMS(L)=ID
L=L+1
114 DO 115 K=1,NX
115 MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
GO TO 8
127 MCLEF(1)=0
111 N=IP(JD)
NR=MCLEF(1)
M=NF(IP(JD))
NW=NR-M
NX=NX+NW
IF(NW)201,120,203
201 JA=N+NR
JB=NX
JC=1
GO TO 204
203 JA=NX
JB=N+NW
JC=-1
204 DO 121 K=JA,JB,JC
121 NF(K)=NF(K-NW)
IF(NR.EQ.0)GO TO 126
120 DO 117 K=1,NR
NF(N)=MCLEF(K)
117 N=N+1
CC L=L-1
IF(NW.EQ.0)GO TO 114
DO 119 K=JD+1,L
119 IP(K)=IP(K)+NW
C FIXES UP FIRST LINE.
CC123 L=L-1
CC NX=NX-1
GO TO 114
126 IP(L+1)=0
CC L=L-1
DO 124 K=JD,L-1
IP(K)=IP(K+1)+NW
124 NMS(K)=NMS(K+1)
NMS(L)=' '
GO TO 114
END
SUBROUTINE ITEM
COMMON /FL/JT,N,L,M,NM,J,NT
I=N
N='S'
C S=SEE
TYPE 1
1 FORMAT(
1' 0 1 2 3 4 5 6 7
1 8 9')
CALL CMBN
N=I
END